home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1995 August: Tool Chest / Dev.CD Aug 95 TC / Dev.CD Aug 95 TC.toast / Tool Chest / Development Tools & Languages / Dylan Related / Mindy / Mindy 1.2 - portable sources / libraries / string-ext / do-replacement.dylan < prev    next >
Encoding:
Text File  |  1995-03-15  |  3.6 KB  |  99 lines  |  [TEXT/ttxt]
  1. module:   do-replacement
  2. author:   Nick Kramer (nkramer@cs.cmu.edu)
  3. synopsis: This implements search and replace facilities, which is 
  4.           given a wrapper and called from both regular-expressions
  5.           and substring-search.
  6. copyright:  Copyright (C) 1994, Carnegie Mellon University.
  7.             All rights reserved.
  8. rcs-header: $Header: do-replacement.dylan,v 1.1 94/11/08 22:55:54 nkramer Exp $
  9.  
  10. //======================================================================
  11. //
  12. // Copyright (c) 1994  Carnegie Mellon University
  13. // All rights reserved.
  14. // 
  15. // Use and copying of this software and preparation of derivative
  16. // works based on this software are permitted, including commercial
  17. // use, provided that the following conditions are observed:
  18. // 
  19. // 1. This copyright notice must be retained in full on any copies
  20. //    and on appropriate parts of any derivative works.
  21. // 2. Documentation (paper or online) accompanying any system that
  22. //    incorporates this software, or any part of it, must acknowledge
  23. //    the contribution of the Gwydion Project at Carnegie Mellon
  24. //    University.
  25. // 
  26. // This software is made available "as is".  Neither the authors nor
  27. // Carnegie Mellon University make any warranty about the software,
  28. // its performance, or its conformity to any specification.
  29. // 
  30. // Bug reports, questions, comments, and suggestions should be sent by
  31. // E-mail to the Internet address "gwydion-bugs@cs.cmu.edu".
  32. //
  33. //======================================================================
  34.  
  35.  
  36. define constant <integer?> = union(<integer>, singleton(#f));
  37.  
  38.  
  39. // The local method expand-replace-sequence probably generates
  40. // excessive garbage for replace-with's that involve backslashes.  One
  41. // might try to allocate the largest newest-piece that'll fit between
  42. // backslashes, rather than turn each string into a character every
  43. // time.
  44. //
  45. define method do-replacement 
  46.     (positioner :: <function>, new-substring :: <string>,
  47.      input :: <string>, start :: <integer>, input-end :: <integer?>, 
  48.      count :: <integer?>, expand-backreferences :: <boolean>)
  49.  => new-string :: <string>;
  50.   local method expand-replace-sequence (marks :: <sequence>)
  51.       if (expand-backreferences & member?('\\', new-substring))
  52.         let return-string = "";
  53.         let index = 0;
  54.         while (index < size(new-substring))
  55.           let newest-piece 
  56.         = if (new-substring[index] ~= '\\')
  57.             as(<string>, new-substring[index]);
  58.           else
  59.             index := index + 1;
  60.             if (~digit?(new-substring[index]))
  61.               as(<string>, new-substring[index]);
  62.             else
  63.               let ref-number 
  64.             = digit-to-integer(new-substring[index]);
  65.               if (marks[2 * ref-number] = #f)
  66.             "";
  67.               else
  68.             copy-sequence(input, start: marks[2 * ref-number],
  69.                       end: marks[1 + 2 * ref-number]);
  70.               end if;
  71.             end if;
  72.           end if;
  73.           return-string := concatenate(return-string, newest-piece);
  74.           index := index + 1;
  75.         end while;
  76.         return-string;
  77.       else
  78.         new-substring;
  79.       end if;
  80.     end method expand-replace-sequence;
  81.  
  82.   let result-string = copy-sequence(input, end: start);
  83.   let index = start;
  84.   let num-matches = 0;
  85.   block (done)
  86.     while (~count | num-matches < count)
  87.       let (#rest marks) = positioner(input, start: index, end: input-end);
  88.       if (marks[0] = #f) done() end;
  89.       result-string 
  90.     := concatenate(result-string, 
  91.                copy-sequence(input, start: index, end: marks[0]), 
  92.                expand-replace-sequence(marks));
  93.       index := marks[1];
  94.       num-matches := num-matches + 1;
  95.     end while;
  96.   end block;
  97.   concatenate(result-string, copy-sequence(input, start: index));
  98. end method do-replacement;
  99.